home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / egavga.swg / 0125_Fading Textscreen.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-24  |  1.8 KB  |  63 lines
  1. {
  2.  AK> howdie, nice fader! i was wandering if you would be able
  3.  AK> to comment the   program and repost it. i.e what the ports
  4.  AK> are etc for us less experienced   programmers...
  5.  
  6. Okay, if you don't quote so much next time.
  7.  
  8. }
  9.  
  10. program copper;
  11. { bar-fade in, copper v7.0, by Bas van Gaalen, Holland, PD }
  12. uses crt;
  13. const size=20; { number of text-lines }
  14. var pal:array[0..3*size-1] of byte;
  15.  
  16. { increase first value in the pal-array (the one representing red), and scroll
  17. that in the array }
  18. procedure incbars;
  19. var i:word;
  20. begin
  21.   if pal[0]<63 then inc(pal[0]);
  22.   for i:=3*size-2 downto 0 do pal[i+1]:=pal[i];
  23. end;
  24.  
  25. procedure copperbars;
  26. var cc,l,j:word;
  27. begin
  28.   asm cli end;
  29.   while (port[$3da] and 8)<>0 do; { vertical retrace }
  30.   while (port[$3da] and 8)=0 do;
  31.   cc:=0;
  32.   for l:=0 to size-1 do begin
  33.     port[$3c8]:=1; { set pal-idx number (1=blue) }
  34.     port[$3c9]:=pal[cc]; { set first two pal-value's (red and green }
  35.     port[$3c9]:=pal[cc+1]; { intensities }
  36.     for j:=0 to 15 do begin { 16 vertical retraces = one text line }
  37.       while (port[$3da] and 1)<>0 do;
  38.       while (port[$3da] and 1)=0 do;
  39.     end;
  40.     port[$3c9]:=pal[cc+2]; { set last pal-value (blue), and thus activate
  41.                              new palette }
  42.     inc(cc,3);
  43.   end;
  44.   asm sti end;
  45. end;
  46.  
  47. var i:byte;
  48. begin
  49.   textmode(co80); { 25 lines mode }
  50.   fillchar(pal,sizeof(pal),0); { clear palette array }
  51.   copperbars; { default = black -> otherwise flash of blue will appear }
  52.   textcolor(1); { set text to blue (now black, 'cos pal changed) }
  53.   writeln;
  54.   writeln('Is this what you mean?'); writeln;
  55.   for i:=1 to 15 do writeln('Test line ',i);
  56.   repeat
  57.     incbars;
  58.     copperbars;
  59.   until keypressed; { do stuff until keypressed... }
  60.   textmode(lastmode); { back to last mode }
  61. end.
  62.  
  63.